C/C++ Interactive Reference Guide

home *** CD-ROM | disk | FTP | other *** search

/ C/C++ Interactive Reference Guide / C-C++ Interactive Reference Guide.iso / c_ref / csource3 / 135_01 / math.csm < prev next >

Wrap

Text File | 1985-03-11 | 20.9 KB | 1,458 lines

; ; MATH.CSM---a high precision (2^2048) integer math package. ; This version based on the package written by M. G. Dinneley, ; published in the March 1977 issue of Dr Dobb's Journal. It ; has been adapted by Thomas Hill for m80 and CP/M. Further ; corrections, additions and adaptions for BDSc by Hugh S. Myers. ; ; M. G. Dinneley ; 3/77 ; ; Thomas Hill ; 8/10/82 ; ; Hugh S. Myers ; 9/30/83 ; 4/2/84 ; INCLUDE <BDS.LIB> ; ; AD1---SIGNED ADDITION. ; FUNCTION AD1 EXTERNAL GPAS1 XRA A ;CLEAR CARRY JMP GPAS1 ENDFUNC ; ; SB1---SIGNED SUBTRACTION. ; FUNCTION SB1 EXTERNAL GPAS1 STC ;SET CARRY JMP GPAS1 ENDFUNC ; ; GPAS1---GENERAL PURPOSE ADD & SUBTRACT (SIGNED). ; FUNCTION GPAS1 EXTERNAL ADD1,SUB1 PUSH PSW ;SAVE FLAGS LDAX D XRA M ;DIFFERING SIGNS? JM GPAS3 POP PSW ;NO JC GPAS4 ;GO DO SUBTRACTION GPAS2: CALL ADD1 ;ELSE DO ADDITION. RET GPAS3: POP PSW JC GPAS2 ;DIFFERING SIGNS, IF SUBTRACT (CARRY SET) THEN ;DO ADDITION RATHER THAN SUBTRACTION. GPAS4: CALL SUB1 RET ENDFUNC ; ; ADD1---SIMPLE POSITIVE ADDITION, ADDS (HL) TO (DE) LEAVING ; RESULT AT (DE). ; FUNCTION ADD1 EXTERNAL LDC2,LDB1,INRM CALL LDC2 ;GET LENGTH OF (HL) TO C PUSH D PUSH H CALL LDB1 ;GET LENGTH OF (DE) TO B SUB C ;COMPARE LENGTHS XCHG JNC ADD2 CMA ;INCREASE AUGEND LENGTH TO ;EQUAL LENGTH OF ADDEND ADC M MOV M,A XRA A ;CLEAR ACCUMULATOR ADD B ;LENGTH OF (DE) JZ ADD5 ;AUGEND IS ZERO, DON'T ADD ADD2: INX H INX D LDAX D ;GET AUGEND BYTE ADC M ;AND ADD IT TO ADDEND PLUS CARRY IF ANY MOV M,A DCR B JZ ADD6 ;NO MORE AUGEND LEFT TO ADD DCR C JNZ ADD2 ;CONTINUE ADDITION ADD3: INX H ;ADDEND EXHAUSTED MOV A,M ADC C MOV M,A DCR B ;CONTINUE BY ADDING ZEROS TO AUGEND ;UNTIL AUGEND EXHAUSTED JNZ ADD3 JNC ADD7 ;FINISHED ADD4: INX H ;OVERFLOW MVI M,1 ;EXTEND RESULT BY CARRY TO NEW DIGIT ;POSITION POP D POP H CALL INRM ;EXTEND LENGTH BYTE BY ONE XCHG RET ADD5: INX H INX D LDAX D ADC B MOV M,A ADD6: DCR C ;ADD ZERO TO ADDEND JNZ ADD5 JC ADD4 ;FINISHED, CHECK FOR OVERFLOWS ADD7: POP H POP D RET ENDFUNC ; ; SUB1---SIMPLE UNSIGNED SUBTRACTION ROUTINE, SUB1 SUBTRACTS ; (HL) FROM (DE) LEAVING THE RESULT AT (DE). ; FUNCTION SUB1 EXTERNAL LDC2,LDB1,DCRM CALL LDC2 PUSH H PUSH D CALL LDB1 ;GET LENGTHS SUB C ;COMPARE THEM. JNC SUB2 XCHG CMA ADC M ;INCREASE MINUEND ;LENGTH (PRESERVE SIGN) MOV M,A XRA A ADD B XCHG JZ SUB3 ;MINUEND EQUALS ZERO SUB2: INX H INX D LDAX D SBB M ;DO THE SUBTRACTION HERE STAX D DCR C JZ SUB7 ;JUMP IF SUBTRAHEND EXHAUSTED DCR B JNZ SUB2 SUB3: INX H ;IF HERE THEN MINUEND EXHAUSTED INX D MOV A,B SBB M ;SUBTRACT ZEROS STAX D DCR C JNZ SUB3 ;CONTINUE UNTIL DONE SUB4: POP H PUSH H ;IF RESULT IS NEGATIVE, FORM TWO'S ;COMPLIMENT. PUSH D MOV A,M RAL CMC RAR MOV M,A ANI 7FH MOV C,A ;LENGTH TO C STC SUB5: INX H MOV A,M CMA ADC B MOV M,A DCR C JNZ SUB5 POP D JMP SUB8 SUB6: INX D LDAX D SBB C STAX D SUB7: DCR B JNZ SUB6 JC SUB4 SUB8: POP H SUB9: LDAX D CMP C ;ANY REDUCTION IN PRECISION? JNZ SUB11 ;NOPE. DCX D SUB10: CALL DCRM ;REDUCE PRECISION JNZ SUB9 SUB11: XCHG POP H RET ENDFUNC ; ; MULT---GENERAL PURPOSE MULTIPLY ROUTINE. MULTIPLIES (DE) BY (HL) ; WITH RESULT STORED AT (DE). THIS ROUTINE HANDLES BOTH NEGATIVE AND ; AND POSITIVE VALUES. NOTE...THIS VERSION HAS BEEN PATCHED TO ALLOW ; (DE) AND (HL) TO POINT AT THE SAME INITIAL NUMBER. ; FUNCTION MULT EXTERNAL LDB2,MOOV,LEFT,RIGHT,ADD1 CALL LDB2 PUSH H LDAX D XRA M ;CHECK SIGNS PUSH PSW ;SAVE RESULT PUSH D PUSH H LXI H,T1 CALL MOOV ;PUT MULTIPLICAND IN T1 WORK AREA POP D LXI H,T2 CALL MOOV ;PUT MULTIPLIER IN T2 WORK AREA POP D XRA A STAX D ;SET RESULT TO ZERO FOR START MULT1: LXI H,T2 MOV A,M ;START MULTIPLICATION ORA A JZ MULT3 ;FINISHED CALL RIGHT LXI H,T1 JNC MULT2 ;LEAST SIGNIFICANT BIT NOT SET, SO DON'T ;ADD CALL ADD1 MULT2: CALL LEFT ;LEFT SHIFT MULTIPLICAND JMP MULT1 MULT3: POP PSW POP H RP ;IF PLUS THEN NO SIGN DIFFERENCE LDAX D XRI 80H ;CHANGE SIGN STAX D RET T1: DS 128 T2: DS 128 ENDFUNC ; ; MODULUS---GENERAL PURPOSE MODULO ROUTINE. ; DIVIDES (DE) BY (HL) WITH REMAINDER TO (DE). ; FUNCTION MODULUS EXTERNAL DDIV XRA A ADI 80H ;CLEAR CARRY AND SET SIGN BIT JMP DDIV ENDFUNC ; ; DIVR---DIVIDE AND ROUND. DIVIDES (DE) BY (HL) WITH RESULT TO (DE) ; AFTER ROUNDING. ; FUNCTION DIVR EXTERNAL DDIV XRA A STC ;SET CARRY AND CLEAR SIGN JMP DDIV ENDFUNC ; ; DIV---DIVIDE ROUTINE. DIVIDES (DE) BY (HL) WITH RESULT TO (DE). ; FUNCTION DIV EXTERNAL DDIV XRA A ;CLEAR CARRY AND CLEAR SIGN JMP DDIV ENDFUNC ; ; DDIV---GENERAL PURPOSE WORKHORSE FOR DIV, MODULUS AND DIVR. ; FUNCTION DDIV EXTERNAL LDC1,LDB1,MOOV,PSHL,SUB1,INCR,RIGHT EXTERNAL LEFT,PARE PUSH H PUSH PSW ;SAVE VECTOR FLAGS LDAX D XRA M ;SIGN DIFFERENCE? RLC JNC DDIV2 ;NO SIGN DIFFERENCES POP PSW INR A ;SIGN DIFFERENCE IN BIT 0 PUSH PSW DDIV2: CALL LDC1 ;GET LENGTH OF DIVISOR JZ RETN ;BAIL OUT IF DIVISOR IS ZERO CALL LDB1 SUB C JM RETN ;DIVISOR IS GREATER THAN DIVIDEND PUSH D INR A MOV B,A MOV C,A ;SAVE LENGTH DIFFERENCE PUSH B LDAX D ANI 7FH ;CLEAR SIGN OF DIVIDEND STAX D MOV A,M ANI 7FH ;CLEAR SIGN OF PARTIAL DIVISOR MOV M,A XCHG LXI H,T1 ;SET TO T1 CALL MOOV ;MOVE DIVISOR FROM (DE) TO T1 (HL) XRA A STA T2 ;ZERO OUT DIVIDEND (T2) POP D DDIV3: CALL PSHL DCR E JNZ DDIV3 MOV C,A MOV B,D DDIV4: POP D PUSH D PUSH B LXI H,T1 CALL PARE ;PARTIAL DIVIDEND >= PARTIAL DIVISOR? JC DDIV5 ;NO CALL SUB1 ;YES, SUBTRACT LXI H,T2 CALL INCR ;INCREMENT QUOTIENT DDIV5: LXI H,T1 CALL RIGHT ;RIGHT SHIFT PARTIAL DIVISOR POP B DCR C ;LOOP COUNT JP DDIV6 MVI C,7 DCR B JM DDIV7 ;END DDIV6: PUSH B LXI H,T2 CALL LEFT ;LEFT SHIFT PARTIAL RESULT POP B JMP DDIV4 ;CONTINUE DIVISION DDIV7: POP D POP PSW ;(DE)-> REMAINDER JM DDIV11 ;MODULO FUNCTION JNC DDIV9 ;NO ROUNDING PUSH PSW CALL PARE ;PARTIAL DIVISOR/2 < REMAINDER? JC DDIV8 JZ DDIV8 ;NO LXI H,T2 CALL INCR ;YES, INCREMENT ANSWER FOR ROUNDING DDIV8: POP PSW DDIV9: XCHG LXI D,T2 ANI 1 JZ DDIV10 ;NO CHANGE OF SIGN LDAX D ORI 80H ;CHANGE SIGN STAX D DDIV10: CALL MOOV ;MOVE RESULT TO (DE) XCHG DDIV11: XRA A POP H LXI H,T2 ;(DE)-> MODULUS, (HL)->QUOTIENT RET RETN: POP PSW STC ;CARRY SET INDICATES NO ;DIVISION POP H RET T1: DS 128 T2: DS 128 ENDFUNC ; ; SQRTR---SQUARE ROOT ROUNDED OF (DE). ; RETURNS RESULT AT (DE). ; FUNCTION SQRTR EXTERNAL SQRT1 ORA A ;CLEAR CARRY FOR ROUNDING JMP SQRT1 ENDFUNC ; ; SQRT---SQUARE ROOT OF (DE) RETURNED AT (DE). ; FUNCTION SQRT EXTERNAL SQRT1 STC ;SET CARRY FOR NO ROUNDING JMP SQRT1 ENDFUNC ; ; SQRT1---WORKHORSE FOR SQRT AND SQRTR. ; FUNCTION SQRT1 EXTERNAL PSHL,ADD1,PARE,SUB1,RIGHT,INCR,MOOV PUSH PSW ;SAVE OPERATION TYPE LDAX D ORA A STC JP SQRT2 POP B RET ;RETURN NO OP IF NEGATIVE OR ZERO SQRT2: MVI C,1 LXI H,T2 MOV M,C INX H MOV M,C ;INITIALIZE T2 TO 1 PUSH D MOV D,A MVI A,0 DCX H SQRT3: CALL PSHL DCR D ;MAKE T2 >N (T2 MUST BE A SQUARE NUMBER) JNZ SQRT3 LXI D,T1 STAX D ;CLEAR T1 SQRT4: CALL ADD1 ;T1 = T1 + T2 XCHG POP D CALL PARE ;N >= T1? PUSH PSW CNC SUB1 ;YES, N = N -T1 POP PSW PUSH D XCHG LXI H,T2 PUSH PSW CNC ADD1 ;YES, T1 = T1 + T2 POP PSW CC SUB1 ;NO, T1 = T1 - T2 XCHG CALL RIGHT ;T1 = T1 / 2 XCHG CALL RIGHT CALL RIGHT ;T2 = T2 / 4 MOV A,M ORA A ;T2 = ZERO? JNZ SQRT4 ;NO POP H POP PSW ;WAS IT ROUND? JC SQRT5 ;NO CALL PARE ;N > T1? JNC SQRT5 XCHG CALL INCR ;YES SO T1 = T1 + 1 XCHG SQRT5: CALL MOOV ;PUT RESULT BACK TO (DE) XCHG ORA A ;CLEAR CARRY FOR GOOD RESULT RET T1: DS 128 T2: DS 128 ENDFUNC ; ; FACT---COMPUTE THE FACTORIAL OF (HL) AND RETURN ; RESULT AT (HL). ; FUNCTION FACT EXTERNAL MOOV,DECR,MULT MOV A,M ANI 7FH ;N=ABS(N). MOV M,A ORA A RZ ;F(0)=0 SO RETURN IF ZERO. CPI 1 ;CHECK FOR SPECIAL CASE OF N=1 ;AND N=2. JNZ FAC1 INX H MOV A,M DCX H CPI 1 RZ ;F(1)=1 SO RETURN ONE. CPI 2 RZ ;F(2)=2 SO RETURN TWO. FAC1: PUSH D ;SAVE DE FOR RETURN. XCHG LXI H,FVAR CALL MOOV ;FVAR=N. CALL DECR ;FVAR=FVAR-1. FAC2: CALL MULT ;N=N*FVAR. CALL DECR ;FVAR=FVAR-1. MOV A,M CPI 1 JNZ FAC2 INX H MOV A,M DCX H CPI 1 ;DECREASE FVAR TO 1 STEP -1. JNZ FAC2 XCHG ;(HL)->N!, (DE)->FVAR. POP D ;RESTORE D. RET FVAR: DS 128 ENDFUNC ; ; POW---GIVEN (HL)=X AND (DE)=N, RETURN P(X,N) AT (DE), WHERE ; N IS A POSITIVE INTEGER. THIS ROUTINE USES ALGORITHM A, PAGE ; 442 OF SEMINUMERICAL ALGORITHMS, BY D. KNUTH. ; FUNCTION POW EXTERNAL MOOV,RIGHT,MULT PUSH H ;SAVE FOR ALL RETURNS. PUSH D ;SAVE FOR ALL RETURNS. XRA A STA PNEG ;CLEAR NEGATIVE RETURN FLAG. MOV A,M ORA A JZ RET0 ;P(0,N)=0. ANI 80 ;IS X <0? JZ POW0 ;NO. INX D LDAX D ;GET N. DCX D ANI 1 ;IS N ODD OR EVEN? JZ POW0 ;N IS EVEN SO SKIP. STA PNEG ;SET SIGN FOR RETURN. POW0: MOV A,M ANI 7FH ;IGNORE SIGN FOR NOW. CPI 1 JNZ POW1 INX H MOV A,M DCX H CPI 1 JZ RET1 ;P(1,N)=1. POW1: XCHG MOV A,M ANI 7FH ;N=ABS(N). MOV M,A ORA A JZ RET1 ;P(X,0)=1. CPI 1 JNZ POW2 INX H MOV A,M DCX H CPI 1 JZ RETX ;P(X,1)=X. POW2: PUSH H LXI H,Y MVI M,1 INX H MVI M,1 ;Y=1. LXI H,Z CALL MOOV ;Z=X. POP H POW3: INX H MOV A,M DCX H ANI 1 PUSH PSW ;TEST FOR ODD/EVEN AND SAVE RESULT. CALL RIGHT ;SHIFT RIGHT ONE BIT, N=N/2. POP PSW JZ POW4 ;SEE STEP A2...POW4 CORRESPONDS TO A5. PUSH H PUSH D LXI D,Y LXI H,Z CALL MULT POP D POP H MOV A,M ORA A JZ RETY POW4: PUSH H PUSH D LXI D,Z LXI H,Z CALL MULT POP D POP H JMP POW3 RET0: POP D POP H MVI A,0 STAX D RET RET1: POP D POP H MVI A,1 STAX D INX D STAX D DCX D RET RETX: POP D POP H XCHG CALL MOOV XCHG RET RETY: LDA PNEG ORA A JZ RETY1 LDA Y XRI 80H STA Y RETY1: POP D XCHG LXI D,Y CALL MOOV POP H RET PNEG: DB 0 Y: DS 128 Z: DS 128 ENDFUNC ; ; GCD---GIVEN (DE)=A AND (HL)=B, RETURN THE GREATEST COMMON ; DIVISOR AT (DE). ; FUNCTION GCD EXTERNAL MOOV,DIV,MULT,SB1 MOV B,M LDAX D ORA B RZ ;BOTH ARE ZERO. MOV A,M ANI 7FH MOV M,A ;B=ABS(B). LDAX D ANI 7FH STAX D ;A=ABS(A). GCD1: PUSH H LXI H,R CALL MOOV ;R=A. POP H PUSH H ;SAVE BECAUSE DIV RETURNS QUOTIENT IN HL CALL DIV ;A=A\B. POP H CALL MULT ;A=A*B. XCHG ;HL=A, DE=B. PUSH D LXI D,R CALL SB1 ;R=R-A. POP D LDA R ORA A JZ RETB ;IF R=0 THEN RETURN B. CALL MOOV ;A=B. XCHG ;HL=B, DE=A. PUSH D LXI D,R CALL MOOV ;B=R. POP D JMP GCD1 RETB: CALL MOOV ;A=B. XCHG ;HL=B, DE=A. RET R: DS 128 ENDFUNC ; ; LCM---GIVEN (DE)=A AND (HL)=B, RETURN THE LEAST COMMON MULTIPLE ; OF A AND B AT (DE). LCM(A,B)=A*B/GCD(A,B). ; FUNCTION LCM EXTERNAL MOOV,MULT,GCD,DIV MOV B,M LDAX D ORA B RZ ;BOTH ARE ZERO. MOV A,M ANI 7FH MOV M,A ;B=ABS(B). LDAX D ANI 7FH STAX D ;A=ABS(A). PUSH H LXI H,LCMV CALL MOOV ;LCMV=A. POP H PUSH D LXI D,LCMV CALL MULT ;LCMV=LCMV*B. POP D CALL GCD ;A=GCD(A,B) PUSH H XCHG LXI D,LCMV CALL DIV CALL MOOV XCHG POP H RET LCMV: DS 128 ENDFUNC ; ; RAND---RANDOM NUMBER GENERATOR. IF HL=0 THEN RETURN R(N) ELSE ; RETURN R(1). NUMBER IS RETURNED AT (DE). ; FUNCTION RAND EXTERNAL AD1,MOOV,MULT,MODULUS MOV A,H ORA L JZ RAND1 LXI H,XN MVI M,1 INX H MVI M,1 RAND1: PUSH D LXI D,XN LXI H,RMULT CALL MULT CALL AD1 LXI H,RMOD PUSH H CALL MODULUS POP H POP D XCHG LXI D,XN CALL MOOV XCHG RET XN: DS 128 RMULT: DB 3,1,0,1 RMOD: DB 10H,0FFH,0FFH,0FFH,0FFH DB 0FFH,0FFH,0FFH,0FFH DB 0FFH,0FFH,0FFH,0FFH DB 0FFH,0FFH,0FFH,7FH ENDFUNC ; ; AUXILLIARY ROUTINES ; ; ; LDB1---LOADS REGISTER B WITH LENGTH INDICATOR OF VALUE AT (DE). ; FUNCTION LDB1 LDAX D RAL ORA A RAR MOV B,A ORA A RET ENDFUNC ; ; LDB2---AS LDB1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO. ; FUNCTION LDB2 EXTERNAL LDB1,ABRT CALL LDB1 JZ ABRT RET ENDFUNC ; ; LDC1---LOADS REGISTER C WITH LENGTH INDICATOR OF MULTI-VALUE AT (HL). ; FUNCTION LDC1 MOV A,M RAL ORA A RAR MOV C,A ORA A RET ENDFUNC ; ; LDC2---AS LDC1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO. ; FUNCTION LDC2 EXTERNAL LDC1,ABRT CALL LDC1 JZ ABRT RET ENDFUNC ; ; ABRT---ABORT ROUTINE USED BY LDC2 AND LDB2. ADJUSTS STACK TO RETURN TO ; CALLER'S CALLER. ; FUNCTION ABRT INX SP INX SP RET ENDFUNC ; ; OVFLW---OVERFLOW RECOVERY ROUTINE. CURRENTLY THIS ROUTINE PERFORMS ; AN UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO. ; FUNCTION OVFLW LXI D,OVER MVI C,PSTRNG CALL BDOS JMP BASE OVER: DB 'overflow error$' ENDFUNC ; ; UNFLW---UNDERFLOW RECOVERY ROUTINE. CURRENTLY THIS ROUTINE PERFORMS ; AND UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO. ; FUNCTION UNFLW LXI D,UNDER MVI C,PSTRNG CALL BDOS JMP BASE UNDER: DB 'underflow error$' ENDFUNC ; ; INRM---INCREMENT LENGTH INDICATOR OF VALUE AT (HL). ; FUNCTION INRM EXTERNAL OVFLW MOV A,M INR M XRA M RP ;CHECK FOR SIGN CHANGE JMP OVFLW ;IF NEGATIVE, THEN SIZE LIMIT EXCEEDED. ENDFUNC ; ; DCRM---DECREMENT LENGTH INDICATOR OF VALUE AT (DE). ; FUNCTION DCRM EXTERNAL UNFLW MOV A,M CPI 81H ;IS IT ZERO PLUS ONE? JZ LABB DCR M RZ ;RETURN WITH ZERO SET FOR ;ZERO XRA M ;SIGN CHANGE? RP ;NO, ELSE JMP UNFLW ;UNDERFLOW CONDITION HERE LABB: MVI M,0 ;SPECIAL CASE OF ZERO AS LENGTH AND RET ;VALUE. ENDFUNC ; ; INCR---ADD ONE TO (HL) ; FUNCTION INCR EXTERNAL LDC1,INCR2,INCR3 PUSH H CALL LDC1 ;GET LENGTH JZ INCR2 INCR1: INX H INR M ;INCREMENT DATA JNZ INCR3 ;OVERFLOW? DCR C JNZ INCR1 ;LOOP TILL DONE JMP INCR2 ENDFUNC ; ; INCR2---PART OF INCR ; FUNCTION INCR2 EXTERNAL INRM INCR2: INX H MVI M,1 ;EXTEND PRECISION POP H CALL INRM ;EXTEND LENGTH RET ENDFUNC ; ; INCR3---PART OF INCR ; FUNCTION INCR3 POP H RET ENDFUNC ; ; DECR---SUBTRACT ONE FROM (HL). ; FUNCTION DECR EXTERNAL INCR,LDC2,MOOV,DCRM MOV A,M ORA A JZ DECR3 ANI 80H JNZ INCR PUSH H CALL LDC2 INX H MOV A,M SBI 1 MOV M,A DCR C JZ DECR2 DECR1: INX H MOV A,M SBI 0 MOV M,A DCR C JNZ DECR1 DECR2: POP H ORA A RNZ CALL DCRM RET DECR3: MVI M,81H INX H MVI M,1 DCX H RET ENDFUNC ; ; LEFT---SHIFT (HL) LEFT ONE BIT, MULTIPLY BY 2. ; FUNCTION LEFT EXTERNAL LDC2,INCR2 CALL LDC2 PUSH H LEFT1: INX H MOV A,M ;GET BYTE RAL MOV M,A ;RESTORE SHIFTED DCR C ;DECREMENT COUNTER JNZ LEFT1 JC INCR2 ;EXTEND PRECISION IF OVERFLOW OFF END POP H RET ENDFUNC ; ; RIGHT---SHIFT (HL) RIGHT ONE BIT, DIVIDE BY 2. ; FUNCTION RIGHT EXTERNAL LDC2,DCRM CALL LDC2 MVI B,0 DAD B ;GO TO TO HIGH END MOV A,M RAR MOV M,A ;ROTATE RIGHT MOV B,A ;SAVE NEW TOP BYTE RIGHT1: DCX H DCR C JZ RIGHT2 MOV A,M RAR MOV M,A JMP RIGHT1 ;HANDLE REST OF DATA RIGHT2: DCR B ;WAS NEW TOP EQUAL TO ZERO? RP ;NO. PUSH PSW ;IF YES, THEN SAVE CARRY (= LOST BIT) CALL DCRM ;CHANGE LENGTH POP PSW RET ENDFUNC ; ; MOOV---MOVE VALUE FROM (DE) TO (HL) ; FUNCTION MOOV EXTERNAL LDB1 CALL LDB1 MOV M,A RZ ;WAS LENGTH EQUAL TO ZERO? LDAX D ;NO, THEN MOVE THINGS MOV M,A ;STORE PROPER LENGTH COUNT PUSH D PUSH H ;SAVE POINTERS MOOV1: INX D INX H LDAX D MOV M,A DCR B JNZ MOOV1 POP H POP D RET ENDFUNC ; ; PARE---COMPARE TWO MULTI-BYTE VALUES (DE) TO (HL). ; RETURNS ZERO SET IF EQUAL, CARRY SET IF (DE)<(HL). ; FUNCTION PARE EXTERNAL LDC1 MOV A,M RAL ;SIGN TO CARRY CMC ;SET TO TRUE RAR ;PUT IT BACK MOV B,A LDAX D RAL ;SAME TO (DE) CMC RAR CMP B ;COMPARE LENGTHS RNZ ;LENGTHS NOT EQUAL CALL LDC1 ;GET LENGTH OF (HL) PUSH H PUSH D MVI B,0 DAD B ;POINT TO HIGH BYTE OF (HL) XCHG DAD B ;POINT TO HIGH BYTE OF (DE) XCHG PARE1: LDAX D CMP M ;COMPARE BYTES JNZ PARE2 ;NOT EQUAL DCX H DCX D ;TRY NEXT BYTE DOWN DCR C JNZ PARE1 PARE2: POP D POP H RET ENDFUNC ; ; PSHL---DEQUEUE UTILITY, PUSH VALUE TO BEGINING OF (HL). ; FUNCTION PSHL EXTERNAL OVFLW PUSH PSW ;SAVE VALUE MVI B,0 MOV A,M ;GET LENGTH ORA A MOV C,A ;MOVE LENGTH TO C AS A COUNTER JZ PSHL2 ;IF ZERO, NO NEED TO SHUFFLE DATA AROUND DAD B ;GOTO HIGH END OF DATA PSHL1: MOV A,M INX H MOV M,A DCX H DCX H DCR C JNZ PSHL1 PSHL2: INR M ;ADVANCE LENGTH JZ OVFLW ;OVERFLOW CONDITION POP PSW INX H MOV M,A ;PUT NEW BYTE AWAY DCX H RET ENDFUNC ; ; POPL---DEQUEUE UTILITY, POP FROM BEGINING OF (HL). ; FUNCTION POPL MOV A,M ;GET LENGTH ORA A RZ ;NOTHING TO GET MOV C,A PUSH H INX H MOV B,M ;GET DATA BYTE POPL1: INX H MOV A,M DCX H MOV M,A INX H DCR C JNZ POPL1 POP H DCR M ;LENGTH EQUALS LENGTH MINUS ONE MOV A,B ;DATA REMOVED TO ACCUMULATOR RET ENDFUNC ; ; PSHH---DEQUEUE UTILITY, PUSH DATA ONTO END OF (HL). ; FUNCTION PSHH EXTERNAL OVFLW PUSH H PUSH PSW ;SAVE DATA BYTE AND LENGTH BYTE INR M ;EXTEND LENGTH JZ OVFLW ;OVERFLOW CONDITION MOV C,M ;LENGTH MVI B,0 DAD B ;GOTO HIGH END OF DATA POP PSW MOV M,A ;PUT DATA IN POSITION POP H RET ENDFUNC ; ; POPH---DEQUEUE UTILITY, POP DATA FROM END OF (HL). ; FUNCTION POPH MOV A,M ;LENGTH ORA A RZ ;NOTHING TO GET MOV C,A PUSH H MVI B,0 DAD B ;GOTO HIGH END OF DATA MOV A,M ;GET BYTE POP H PUSH PSW ;SAVE IT DCR M ;LENGTH EQUALS LENGTH MINUS ONE POP PSW RET ENDFUNC ; ; DECTOHEX---GIVEN A STRING AT (HL) IN STANDARD FORM, ; N BYTES, FOLLOWED BY A NULL CHAR, CONVERT TO HEX NUMBER ; IN VERY LONG INTEGER FORMAT AT (DE). ; FUNCTION DECTOHEX EXTERNAL MULT,AD1 XRA A STAX D STA NFLAG MOV A,M CPI '-' JNZ DTH11 MVI A,1 STA NFLAG INX H DTH1: MOV A,M DTH11: ANI 0FH ORA A JZ DTH2 ;SKIP IF DIGIT IS ZERO STA DIGIT+1 PUSH H LXI H,DIGIT CALL AD1 POP H DTH2: INX H ;GET NEXT DIGIT IF ANY MOV A,M ORA A ;IS IT A NULL? JZ DTH3 ;YES, THEN FINISHED PUSH H LXI H,TEN CALL MULT ;SHIFT TO NEXT DIGIT POSITION POP H JMP DTH1 DTH3: LDA NFLAG ORA A RZ LDAX D ORI 80H STAX D RET TEN: DB 1,10 DIGIT: DB 1,0 NFLAG: DB 0 ENDFUNC ; ; HEXTODEC---CONVERT HEX NUMBER IN VERY LONG INTEGER FORMAT ; AT (DE) TO A DECIMAL NUMBER (STRING), RETURN ADDRESS IN HL. ; FOR MORE INFORMATION ON RADIX CONVERSION SEE KNUTH, VOL 2, ; "SEMINUMERICAL ALGORITHMS" PP 302-310. ; FUNCTION HEXTODEC EXTERNAL MODULUS,MOOV EXP: EQU 12 ;FOR RADIX 10^12 CONVERSION LDAX D CPI 80H JZ HTD0 ;HANDLE CASE OF "-0" ORA A JNZ HTD1 ;HANDLE CASE OF "0" HTD0: LXI H,ANSWER MVI M,30H INX H MVI M,0 DCX H RET HTD1: XRA A STA NFLAG LXI H,INDEX SHLD INDEXPTR LXI H,TEMPARRAY SHLD TEMPPTR LXI H,ANSEND SHLD ANSPTR LDAX D ORA A JP HTD2 MVI A,'-' ;NUMBER IS NEGATIVE STA NFLAG HTD2: LXI H,RADIX CALL MODULUS CALL HTD14 ;MOVE RESULT TO T2 JC HTD3 LHLD TEMPPTR CALL MOOV PUSH D XCHG LHLD INDEXPTR MOV M,E INX H MOV M,D INX H SHLD INDEXPTR XCHG POP D LDAX D MOV C,A MVI B,0 DAD B INX H SHLD TEMPPTR XCHG LXI D,T2 CALL MOOV XCHG JMP HTD2 HTD3: LHLD TEMPPTR CALL MOOV XCHG LHLD INDEXPTR MOV M,E INX H MOV M,D INX H MVI M,0 INX H MVI M,0 HTD4: LXI H,INDEX SHLD INDEXPTR HTD5: LHLD INDEXPTR MOV E,M INX H MOV A,M ORA E JZ HTD9 MOV D,M INX H SHLD INDEXPTR LXI H,TEMP CALL MOOV LDA TEMP ORA A JZ HTD7 HTD6: MVI A,EXP STA RCNT HTD61: LXI D,TEMP LXI H,TEN LDAX D ORA A JZ HTD62 CALL MODULUS CALL HTD14 ;MOVE RESULT TO T2 INX D LDAX D DCX D CALL HTD13 LDA RCNT DCR A JZ HTD5 STA RCNT XCHG LXI D,T2 CALL MOOV XCHG JMP HTD61 HTD62: LDA RCNT ORA A JZ HTD5 DCR A STA RCNT MVI A,0 CALL HTD13 JMP HTD62 HTD7: MVI B,EXP HTD8: MVI A,0 CALL HTD13 DCR B JNZ HTD8 JMP HTD5 HTD9: LHLD ANSPTR HTD10: INX H MOV A,M CPI 30H JZ HTD10 LDA NFLAG ORA A RZ DCX H MOV M,A RET HTD13: PUSH H LHLD ANSPTR ADI 30H MOV M,A DCX H SHLD ANSPTR POP H RET HTD14: PUSH PSW PUSH H PUSH D LXI D,T2 XCHG ;MOVE QUOTIENT TO T2 CALL MOOV POP D POP H POP PSW RET RCNT: DB 0 T2: DS 128 NFLAG: DB 0 DIGIT: DB 1,0 TEN: DB 1,10 RADIX: DB 05,00 DB 10H,0A5H,0D4H,0E8H INDEXPTR: DW 0 TEMPPTR: DW 0 ANSPTR: DW 0 INDEX: DS 128 TEMP: DS 128 TEMPARRAY: DS 512 ANSWER: DS 320 ANSEND: DS 1 DB 0 ;NULL TERMINATOR. ENDFUNC END